home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / archiver / mdcd10.zip / MDCD.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-26  |  65KB  |  1,263 lines
  1. {---- 10/26/1988  00:26:31 ----}
  2. {$A-,R-,B-,S-,I-,F-,O-,V-,N-,E-,D+,L+}
  3. {$M 3072,0,45000}                                { stack, min heap, max heap }
  4. {----------------------------------------------------------------------------}
  5. {                                                                            }
  6. {                                 'MDCD'                                     }
  7. {                                                                            }
  8. {  File compress and decompress utility.                                     }
  9. {                                                                            }
  10. {     Written By:  Mike Davenport                                            }
  11. {                  Mike Davenport & Associates                               }
  12. {                  6751 N. Blackstone Ave. Suite 252                         }
  13. {                  Fresno CA  93710                                          }
  14. {                  Voice: (209) 298-8846                                     }
  15. {                  CIS:   76676,1362                                         }
  16. {                  PLINK: MIKE D                                             }
  17. {                  GENIE: MDAVENPORT                                         }
  18. {                  Amiga Techniques + PC Tech BBS - (GT POWER)               }
  19. {                  (209) 298-8453 - 1200-9600 HST (24 hours)                 }
  20. {                                                                            }
  21. {----------------------------------------------------------------------------}
  22. {                                                                            }
  23. {                          ----------------------                            }
  24. {                          PROGRAM CHANGE HISTORY                            }
  25. {                          ----------------------                            }
  26. {                                                                            }
  27. { change#  ..date..  by  .................. change ........................  }
  28. {                                                                            }
  29. {   000    10-14-88  md  Original module creation - version .9               }
  30. {   001    10-19-88  md  Original module finished - version .9 (beta)        }
  31. {   002    10-22-88  md  Added 13 bit compression interface                  }
  32. {   003    10-26-88  md  Finished 1.0 release                                }
  33. {                                                                            }
  34. {----------------------------------------------------------------------------}
  35. {                                                                            }
  36. {                                                                            }
  37. {  INTERNAL Modules                                                          }
  38. {  --------                                                                  }
  39. {  TYPE  ...... NAME ...........  ............ DESCRIPTION ................. }
  40. {                                                                            }
  41. {  Func  CompressFile             LZW file compress from mdcd1213.obj        }
  42. {  Func  DeCompressFile           LZW file decompress from mdcd1213.obj      }
  43. {  Func  TimeStamp                Get time in milli-seconds since midnite    }
  44. {  Proc  GetKey                   Inline get key routine via int 16h         }
  45. {  Proc  CheckIO                  Check IOResult for file and error/halt     }
  46. {  Func  CompressOneFile          Setup for compressing one file             }
  47. {  Func  ProcessCompress          Processes command line C compress option   }
  48. {  Func  ProcessDeCompress        Processes command line D/R decompress optn }
  49. {  Func  ProcessList              Processes command line F/L list option     }
  50. {  Func    CVS                    Local to ProcessList - convert word to str }
  51. {  Proc  DisplayHelp              Display program LOGO & help screen         }
  52. {                                                                            }
  53. {----------------------------------------------------------------------------}
  54.  
  55. Program MDCD;
  56.  
  57. Uses Dos;
  58.  
  59.   {$L MDCD1213.OBJ}           { Assembler module for LZW compress/decompress }
  60.  
  61. {$F+}
  62. Function CompressFile(InFile  : Word;     {handle of input file              }
  63.                       OutFile : Word;     {handle of output file             }
  64.                       AbsOfst : LongInt;  {absolute offset to start write at }
  65.                       RP      : Pointer;  {pointer to return area            }
  66.                       HashSg  : Word;     {segment:0 of allocated hash table }
  67.                       LZWtype : Word      {12 = 12 bit, 13 = 13 bit lzw      }
  68.                      )        : Word;     {-1 = good return                  }
  69.     external {MDCD1213} ;
  70. {$F-}
  71.  
  72.  
  73. {$F+}
  74. Function DeCompressFile(InFile  : Word;    {handle of input file             }
  75.                         OutFile : Word;    {handle of output file            }
  76.                         AbsOfst : LongInt; {absolute offset to start write at}
  77.                         RP      : Pointer; {pointer to return area           }
  78.                         HashSg  : Word;    {segment:0 of allocated hash table}
  79.                         LZWtype : Word     {12 = 12 bit, 13 = 13 bit lzw     }
  80.                        )        : Word;    {-1 = good return                 }
  81.     external {MDCD1213} ;
  82. {$F-}
  83.  
  84.  
  85. Type
  86.  
  87.   Array4     = Array[1..4] of Char;
  88.   String12   = String[12];
  89.   String2    = String[2];
  90.   DirPtr     = ^DirStr;                   {to allocate Dir on heap           }
  91.   OutFilePtr = ^PathStr;                  {to allocate file full path on heap}
  92.   InFilePtr  = ^PathStr;                  {to allocate file full path on heap}
  93.   SRecPtr    = ^SearchRec;                {to allocate findfirst/next on heap}
  94.  
  95.   FileHeader = Record                     {header for each compressed file   }
  96.     Signature    : Array4;                {file/header signature (MDmd)      }
  97.     ReleaseLevel : Byte;                  {compress version                  }
  98.     HeaderType   : Byte;                  {header type. only type 1 for now  }
  99.     HeaderSize   : Word;                  {size of this header in bytes      }
  100.     UserInfo     : Word;                  {any user info desired             }
  101.     Reserved1    : Word;                  {future use and upward compatablty }
  102.     Reserved2    : LongInt;               {future use and upward compatablty }
  103.     Reserved3    : Array[1..8] of byte;   {future use and upward compatablty }
  104.     CompressType : Byte;                  {type of compression               }
  105.     OrigFileSize : LongInt;               {original file size in bytes       }
  106.     CompFileSize : LongInt;               {compressed file size in bytes     }
  107.     FileAttr     : Word;                  {original file attribute           }
  108.     FileDate     : LongInt;               {original file date/time           }
  109.     FileCRC      : Word;                  {file crc                          }
  110.     FileName     : String12;              {file name                         }
  111.     PathName     : DirStr;                {original drive\path               }
  112.   end;
  113.  
  114.   FileHeaderPtr  = ^FileHeader;           {pointer to allocate my header/heap}
  115.  
  116. { return code from mdcd1213.obj module }
  117.  
  118.   ReturnRec = Record                      {return info from mdcd1213.obj     }
  119.     FileCrc  : Word;                      {  calculated file crc decompressed}
  120.     FileSize : LongInt;                   {  compressed/decompressed filesize}
  121.   end;                                    {..                                }
  122.  
  123. Const
  124.   PgmRelLvl    = 10;                      {mdcd program release level        }
  125.   Compressed   = 1;                       {indicates LZW 13 bit compression  }
  126.   UnCompressed = 0;                       {indicates NO compression          }
  127.   LZWH1 = 20480*2;                        {size of LZW hash compress 13 bit  }
  128.   LZWH2 = 12288*2;                        {size of LZW hash decompress 13 bit}
  129.   LZWBits = 13;                           {number of LZW bits for compression}
  130.   ValidSig : Array4 = 'MDmd';             {signature to verify mdcd file     }
  131.   HexXlate : Array[0..$F] of Char =       {table to translate word to hex    }
  132.              '0123456789ABCDEF';
  133.   Dashes =
  134.   '-------------------------------------------------------------------------';
  135.   Hdr1 = 'MDCD File Compress/DeCompress Utility     Version  1.0    10-23-88';
  136.   Hdr2 = 'Mike Davenport  CIS: 76676,1362  BBS: (209) 298-8453 1200-9600 HST';
  137.  
  138. Var
  139.   MRC      : Word;                        {storage for mainline return code  }
  140.   InKey    : Word;                        {input from int 16 keyboard        }
  141.   WorkStr  : String12;                    {work string                       }
  142.   Option   : Char;                        {command line option requested     }
  143.   ReturnR  : ReturnRec;                   {storage for return info from mdcd }
  144.   InF      : File;                        {input file                        }
  145.   OutF     : File;                        {output file                       }
  146.   StartTime: LongInt;                     {start time from midnite in ms     }
  147.   BeginTime: LongInt;                     {start time from midnite in ms     }
  148.   MDCheck  : Array4;                      {check for valid mdcd file         }
  149.   FileCount: Word;                        {number of files processed         }
  150.   ForceCopy: Boolean;                     {force file copy vs. compression   }
  151.  
  152.  
  153. {----------------------------------------------------------------------------}
  154. {                                                                            }
  155. {                    function    'TimeStamp'                                 }
  156. {                                                                            }
  157. {  This function returns the number of milliseconds since midnite            }
  158. {                                                                            }
  159. {----------------------------------------------------------------------------}
  160.  
  161. Function TimeStamp : LongInt;
  162.  
  163. Var
  164.   Hour   : Word;
  165.   Minute : Word;
  166.   Second : Word;
  167.   Sec100 : Word;
  168.  
  169. begin {TimeStamp}
  170.  
  171.   GetTime(Hour, Minute, Second, Sec100);     {Borlands int 21h 2ch           }
  172.   TimeStamp := 1000*((LongInt(Hour)*3600) +  {1000 times seconds in hours +  }
  173.                      (LongInt(Minute)*60) +  {seconds in minutes +           }
  174.                      (LongInt(Second)) )  +  {seconds )                      }
  175.                       Sec100;                {+ hundreths of seconds         }
  176.  
  177. end; {TimeStamp}
  178.  
  179.  
  180. {----------------------------------------------------------------------------}
  181. {                                                                            }
  182. {                              Procedure 'GetKey'                            }
  183. {                                                                            }
  184. {  This procedure calls ROM-BIOS interrupt 16H to check for the keyboard     }
  185. {  status.  If no key is ready, then it returns 0 for both the keyboard scan }
  186. {  code and character.  If a key is ready, then it returns both the keyboard }
  187. {  scan code and the character.  If one of the extended or function keys is  }
  188. {  pressed, the character returned will be an ASCII zero.  The scan code is  }
  189. {  then used to determine the exact identity of the key stroke.  This rou-   }
  190. {  tine sets the global variable "inkey" to the last key stroke pressed.     }
  191. {                                                                            }
  192. {----------------------------------------------------------------------------}
  193.  
  194. Procedure GetKey;
  195.  
  196. begin { GetKey }
  197.  
  198.   inline($C7/$06/inkey/$00/$00/ {  mov  word ptr ds:[inkey],0h ;init.        }
  199.          $B4/$01/               {  mov  ah,01h                 ;key ready?   }
  200.          $CD/$16/               {  int  16h                    ;kbd serv.    }
  201.          $74/$07/               {  jz   ex                     ;no key       }
  202.          $B4/$00/               {  mov  ah,00h                 ;get key      }
  203.          $CD/$16/               {  int  16h                    ;kbd serv.    }
  204.          $A3/inkey);            {  mov  word ptr ds:[inkey],ax ;result       }
  205.                                 {ex:                           ;exit label   }
  206.  
  207. end; { GetKey }
  208.  
  209.  
  210. {----------------------------------------------------------------------------}
  211. {                                                                            }
  212. {                    procedure   'CheckIO'                                   }
  213. {                                                                            }
  214. {  This procedure checks the IOResult code for a file and displays an error  }
  215. {  and halts if the error is non-zero.                                       }
  216. {                                                                            }
  217. {----------------------------------------------------------------------------}
  218.  
  219. Procedure CheckIO(var F : File);
  220.  
  221. Var
  222.   r : Word;
  223.   d : Word;
  224.  
  225. begin {CheckIO}
  226.  
  227.   r := IoResult;
  228.   d := DosError;
  229.   if ((r+d) <> 0) then begin
  230.     WriteLn;
  231.     Write('IOResult: ', r:3, ' DOS Error: ', d:3, ' while reading/writing File: ');
  232.     r := 0;
  233.     While (FileRec(f).Name[r] <> #0) do begin
  234.       Write(FileRec(F).Name[r]);
  235.       Inc(r);
  236.     end;
  237.     WriteLn;
  238.     Repeat GetKey; Until (InKey = 0);             {flush keyboard buffer}
  239.     WriteLn('Press any key to continue....');
  240.     Repeat GetKey; Until (InKey <> 0);            {until keypressed}
  241.     WriteLn;
  242.     Halt(1);
  243.   end;
  244.  
  245. end; {CheckIO}
  246.  
  247.  
  248. {----------------------------------------------------------------------------}
  249. {                                                                            }
  250. {                    function    'CompressOneFile'                           }
  251. {                                                                            }
  252. {  This procedure coordinates the compression of a single file               }
  253. {                                                                            }
  254. {----------------------------------------------------------------------------}
  255.  
  256. Function CompressOneFile(CInputFile   : String12;  {file to compress         }
  257.                          COutputFile  : PathStr;   {compress output file     }
  258.                          CDir         : DirStr;    {input path               }
  259.                          CUserInfo    : Word)      {any user info            }
  260.                                       : Word;      {function returns a word  }
  261.  
  262. Var
  263.   i        : Word;                    {loop control/work variable            }
  264.   r        : Word;                    {return code                           }
  265.   ReSeek   : LongInt;                 {file byte to seek to for compress data}
  266.   HdrSeek  : LongInt;                 {file byte to seek to for header data  }
  267.   FileHdr  : FileHeaderPtr;           {compress file header record pointer   }
  268.   IHandle  : Word;                    {handle of input file for mdcd1213.obj }
  269.   OHandle  : Word;                    {handle of output file for mdcd1213.obj}
  270.   HashPtr  : Pointer;                 {pointer to heap allocated hash table  }
  271.   HashSeg  : Word;                    {segment of allocated hash table       }
  272.   ActualR  : Word;                    {bytes actually read w/blockread       }
  273.   ActualW  : Word;                    {bytes actually written w/blockwrite   }
  274.   CmpType  : Word;                    {type of file compression used         }
  275.   CopyPtr  : Pointer;                 {pointer to heap buffer for block(r/w) }
  276.   OtherChk : Byte;                    {check .ARC ^Z or .ZOO 'Z' as first chr}
  277.  
  278. begin {CompressOneFile}
  279.  
  280.   StartTime := TimeStamp;               {get time in ms since midnite        }
  281.  
  282. { create or open the output file & make sure its a valid compress file }
  283.  
  284.   Assign(OutF, COutputFile);            {setup output file variable          }
  285.   Reset(OutF,1);                        {attempt to open output file         }
  286.   If (IOResult <> 0) then begin         {if file was not opened..            }
  287.     ReWrite(OutF,1);                    {  create output file                }
  288.     CheckIO(OutF);
  289.   end                                   {..                                  }
  290.   else begin                            {else                                }
  291.     BlockRead(OutF, MDCheck, 4);        {  read first 4 bytes for signature  }
  292.     CheckIO(OutF);
  293.     if (MDCheck <> ValidSig) then begin {  if not a valid signature          }
  294.       CompressOneFile := 999;           {    set return code                 }
  295.       Exit;                             {    get out                         }
  296.     end;                                {  ..                                }
  297.   end;                                  {..                                  }
  298.  
  299. { open input file }
  300.  
  301.   Assign(InF, CDir+CInputFile);         {setup input file variable           }
  302.   System.FileMode := 0;                 {read only to get hidden/sys files   }
  303.   Reset(InF,1);                         {open input file to assign handle    }
  304.   System.FileMode := 2;                 {read write                          }
  305.   r := IOResult;                        {get io return code                  }
  306.   If (r <> 0) then begin                {if return code is bad..             }
  307.     CompressOneFile := r;               {  set return code                   }
  308.     Exit;                               {  get out                           }
  309.   end;                                  {..                                  }
  310.  
  311. { seek to end of output file and write a dummy header to reserve space }
  312.  
  313.   HdrSeek := FileSize(OutF);            {get the current end of file         }
  314.   Seek(OutF, HdrSeek);                  {seek to the end of the file         }
  315.   New(FileHdr);                         {allocate header record on heap      }
  316.   BlockWrite(OutF, FileHdr^,            {write dummy header to make space    }
  317.              SizeOf(FileHdr^));         {                                    }
  318.   CheckIO(OutF);
  319.   ReSeek := HdrSeek + SizeOf(FileHdr^); {seek past header to end of file     }
  320.  
  321. { get everything set up and go and compress the file }
  322.  
  323.   IHandle := FileRec(InF).Handle;       {extract input file handle           }
  324.   OHandle := FileRec(OutF).Handle;      {extract output file handle          }
  325.  
  326.   Write(CInputFile:12, ',',             {write compress info to screen       }
  327.         FileSize(InF):7,' --> ',        {                                    }
  328.         COutputFile, ',');              {                                    }
  329.  
  330. { if .ZOO or .ARC file check for 'Z' or ^Z to double check }
  331.  
  332.   If (ForceCopy) then begin             {if .ZOO or .ARC file extension      }
  333.     BlockRead(InF, OtherChk, 1);        {  read first byte of file           }
  334.     CheckIO(InF);                       {  check io error                    }
  335.     Seek(InF, 0);                       {  seek to the beginning of the file }
  336.     CheckIO(InF);                       {  check io error                    }
  337.     If ( (OtherChk <> $1A) and          {  if first byte not ^Z and          }
  338.          (OtherChk <> $5A) ) then begin {     first byte not Z then          }
  339.       ForceCopy := False                {    turn off forced copy & compress }
  340.     end;                                {  ..                                }
  341.   end;                                  {..                                  }
  342.  
  343.   if (not ForceCopy) then begin
  344.     GetMem(HashPtr, LZWH1+15);          {get memory for hash table + 15 bytes}
  345.     if Ofs(HashPtr^) = 0 then           {if offset -0- then seg is okay      }
  346.       HashSeg := Seg(HashPtr^)          {  store segment                     }
  347.     else                                {else                                }
  348.       HashSeg := 1+Seg(HashPtr^);       {  add 1 paragraph (16 bytes) to seg }
  349.  
  350.     r := CompressFile(                  {compress the file                   }
  351.                       Ihandle,          {input file handle                   }
  352.                       Ohandle,          {output file handle                  }
  353.                       ReSeek,           {starting point in output file       }
  354.                       @ReturnR,         {where to send return info back to   }
  355.                       HashSeg,          {segment of heap allocated hash table}
  356.                       LZWBits);         {number of LZW bits                  }
  357.  
  358.     FreeMem(HashPtr, LZWH1+15);   {get rid of heap memory for hash table     }
  359.  
  360.   { display error and halt if error return code }
  361.  
  362.     If (r <> $ffff) then begin
  363.       WriteLn;
  364.       WriteLn('Error: ', r, ' returned from MDCD1213.OBJ - Program Terminated');
  365.       WriteLn;
  366.       Halt(1);
  367.     end;
  368.  
  369.   { close and reopen so we know what mdcd1213.obj did }
  370.  
  371.     Close(InF);                         {close input file                    }
  372.     CheckIO(InF);
  373.     Close(OutF);                        {close output file                   }
  374.     CheckIO(OutF);
  375.     System.FileMode := 0;               {read only to get hidden/sys         }
  376.     Reset(InF,1);                       {open input file to assign handle    }
  377.     CheckIO(InF);
  378.     System.FileMode := 2;               {read write                          }
  379.     Reset(OutF,1);                      {reopen output file to process       }
  380.     CheckIO(OutF);
  381.   end
  382.   else begin
  383.     ReturnR.FileSize:=FileSize(InF)+1;  {force file copy                     }
  384.   end;
  385.  
  386. { if compressed file is larger then input, just copy input file as is }
  387.  
  388.   CmpType := Compressed;                           {assume file is compressed}
  389.   if ReturnR.Filesize > Filesize(InF) then begin   {if compressed > actual ! }
  390.     CheckIO(InF);
  391.     Seek(InF, 0);                                  {  seek to input begin    }
  392.     CheckIO(InF);
  393.     Seek(OutF, ReSeek);                            {  seek to before file    }
  394.     CheckIO(OutF);
  395.     Truncate(OutF);                                {  chop it off            }
  396.     CheckIO(OutF);
  397.     GetMem(CopyPtr, LZWH1);                        {  get heap for buffer    }
  398.     While (not EOF(InF)) do begin                  {  while not end of file  }
  399.       BlockRead(InF, CopyPtr^, LZWH1, ActualR);    {    read original        }
  400.       CheckIO(InF);
  401.       BlockWrite(OutF, CopyPtr^, ActualR, ActualW);{    write as is to output}
  402.       CheckIO(OutF);
  403.       if ActualW <> ActualR then begin             {    if read error        }
  404.         WriteLn;                                   {      disk probaly full  }
  405.         WriteLn('DISK FULL???');                 {      disk probaly full  }
  406.         WriteLn('DISK FULL???');                 {                         }
  407.         WriteLn;                                   {      disk probaly full  }
  408.         Halt(99);                                  {      halt the sucker    }
  409.       end;                                         {    ..                   }
  410.     end;                                           {  ..                     }
  411.     FreeMem(CopyPtr, LZWH1);                       {  release heap buffer    }
  412.     ReturnR.FileSize:=FileSize(InF);               {  set new file size      }
  413.     CheckIO(InF);
  414.     CmpType := UnCompressed;                       {  file is not compressed }
  415.   end;                                             {..                       }
  416.  
  417. { build compressed file header record and write it to the file }
  418.  
  419.   With FileHdr^ do begin                        {Use FileHdr record          }
  420.     Signature := ValidSig;                      {  set compress file id      }
  421.     ReleaseLevel := PgmRelLvl;                  {  set mdcd program id       }
  422.     HeaderType := 1;                            {  only type 1 for now       }
  423.     HeaderSize := sizeof(FileHdr^);             {  set header record size    }
  424.     UserInfo := CUserInfo;                      {  set user info             }
  425.     Reserved1 := 0;                             {  reserved for future use   }
  426.     Reserved2 := 0;                             {  reserved for future use   }
  427.     FillChar(Reserved3, SizeOf(Reserved3), 0);  {  reserved for future use   }
  428.     CompressType := CmpType;                    {  set type of file compress }
  429.     FillChar(FileName, SizeOf(Filename), ' ');  {  clear file name field     }
  430.     FillChar(PathName, SizeOf(Pathname), ' ');  {  clear path name field     }
  431.     FileName := CInputFile;                     {  set file name             }
  432.     PathName := CDir;                           {  set original path name    }
  433.     OrigFileSize := FileSize(InF);              {  set original file size    }
  434.     CheckIO(InF);
  435.     CompFileSize := ReturnR.FileSize;           {  set compressed file size  }
  436.     FileCRC := ReturnR.FileCrc;                 {  set file CRC              }
  437.     GetFTime(InF, FileDate);                    {  set orig'l file data/time }
  438.     CheckIO(InF);
  439.     Close(InF);                                 {  close the input file      }
  440.     CheckIO(InF);
  441.     GetFAttr(InF, FileAttr);                    {  set input file attrubutes }
  442.     CheckIO(InF);
  443.   end;                                          {..                          }
  444.   Seek(OutF, HdrSeek);                          {seek back to header loc'n   }
  445.   CheckIO(OutF);
  446.   BlockWrite(OutF, FileHdr^, SizeOf(FileHdr^)); {write the file header       }
  447.   CheckIO(OutF);
  448.   Close(OutF);                                  {close output file           }
  449.   CheckIO(OutF);
  450.  
  451. { display file info on screen }
  452.  
  453.   Write(FileHdr^.CompFileSize:7);
  454.   If (FileHdr^.OrigFileSize = 0) then
  455.     Write('  ( 0%)')
  456.   else
  457.     Write('  (', 100-((FileHdr^.CompFileSize * 100) / FileHdr^.OrigFileSize):2:0, '%)');
  458.   Write( ' ', ((TimeStamp-StartTime)/1000)+1:4:0, ' seconds');
  459.   Write('  CRC: ');
  460.   Write(HexXlate[Hi(returnr.filecrc) shr 4]);
  461.   Write(HexXlate[Hi(returnr.filecrc) and $F]);
  462.   Write(HexXlate[Lo(returnr.filecrc) shr 4]);
  463.   Write(HexXlate[Lo(returnr.filecrc) and $F]);
  464.   WriteLn;
  465.  
  466.   dispose(FileHdr);                             {free allocated heap space   }
  467.   CompressOneFile := 0;                         {set good return code        }
  468.  
  469. end; {CompressOneFile}
  470.  
  471.  
  472. {----------------------------------------------------------------------------}
  473. {                                                                            }
  474. {                    function    'ProcessCompress'                           }
  475. {                                                                            }
  476. {  This procedure controls the requested (C)ompress option                   }
  477. {                                                                            }
  478. {----------------------------------------------------------------------------}
  479.  
  480. Function ProcessCompress : Word;
  481.  
  482. Var
  483.   Srec     : SRecPtr;              {findfirst/next search record             }
  484.   RC       : Word;                 {return code                              }
  485.   i        : Word;                 {loop control variable                    }
  486.   Done     : Boolean;              {all files processed flag                 }
  487.   Name     : NameStr;              {file name                                }
  488.   TName    : NameStr;              {file name                                }
  489.   Ext      : ExtStr;               {file extension                           }
  490.   TExt     : ExtStr;               {file extension                           }
  491.   Ignore   : String[12];           {name to keep from compressing output file}
  492.   OutFile  : OutFilePtr;           {compressed output file name on heap      }
  493.   InFile   : InFilePtr;            {input file name on heap                  }
  494.   Dir      : DirPtr;               {directory path name on heap              }
  495.   TDir     : DirPtr;               {work dir for fsplit                      }
  496.  
  497. begin {ProcessCompress}
  498.  
  499. { allocate variables from the heap and initialize any required variables }
  500.  
  501.   New(Srec);                       {allocate search record on heap           }
  502.   New(Dir);                        {allocate directory path on heap          }
  503.   New(TDir);                       {allocate directory path on heap          }
  504.   New(OutFile);                    {allocate output file name on heap        }
  505.   New(InFile);                     {allocate input file name on heap         }
  506.   Done := False;                   {reset done processing flag               }
  507.   FileCount := 0;                  {reset processed file count               }
  508.   BeginTime := TimeStamp;          {get starting time                        }
  509.  
  510. { split output file name apart, make sure its a valid compress type of    }
  511. { file, add an extension of .MD if not entered, and save output file name }
  512. { in a form that will compare equal if a FindNext file retrieved for      }
  513. { compression has the same name (don't compress the output file itself!)  }
  514.  
  515.   OutFile^ := FExpand(ParamStr(3));     {expand command line output file name}
  516.   FSplit(OutFile^, Dir^, Name, Ext);    {split it into components            }
  517.   if (Length(Ext)=0) then Ext:='.MD';   {if no extension, assume .md         }
  518.   OutFile^ := Dir^ + Name + Ext;        {rebuild output file name            }
  519.   Ignore := Name + Ext;                 {prevent compressing output file     }
  520.  
  521.  
  522. { split input file mask apart so the original path can be saved.  If no path }
  523. { entered, get the path of the current directory to include in the file.     }
  524.  
  525.   InFile^ := FExpand(ParamStr(2));      {expand input file mask              }
  526.   FSplit(InFile^, Dir^, Name, Ext);     {split it into components            }
  527.   InFile^ := Dir^ + Name + Ext;         {rebuild input file mask             }
  528.  
  529. { get the first file to compress }
  530.  
  531.  {NOTE: the word "Archive" in the line below has no relationship to SEA's    }
  532.  {      pending trademark on the word ARC.  It references a constant defined }
  533.  {      in Borland's Turbo Pascal 5.0 DOS unit, and refers to a file that    }
  534.  {      has the archive bit set.  This is an MSDOS term.                     }
  535.  
  536.   FindFirst(InFile^, ReadOnly+Hidden+SysFile+Archive, SRec^);
  537.   if (DosError<>0) then Done := True;
  538.  
  539. { compress files until there are no more }
  540.  
  541.   While (not Done) do begin                     {while more files            }
  542.     if (DosError=0) then begin                  {  if findnext ok            }
  543.       if (Ignore<>SRec^.Name) then begin        {    if not output file      }
  544.         FSplit(SRec^.Name, TDir^, TName, TExt); {      get file extension    }
  545.         If ( (TExt = '.ARC') or                 {      if .ARC file or       }
  546.              (TExt = '.ZOO') ) then             {      if .ZOO file          }
  547.           ForceCopy := True                     {        cheat and copy      }
  548.         else                                    {      else                  }
  549.           ForceCopy := False;                   {        try compression     }
  550.         RC := CompressOneFile(SRec^.Name,       {      compress this file    }
  551.               OutFile^, Dir^, 0);               {                            }
  552.         If RC = 999 then begin;                 {      if not compress file  }
  553.           WriteLn;                              {        tell the user       }
  554.           WriteLn('Output file: ', Outfile^,   {         "                  }
  555.               ' is not a valid compress file'); {         "                  }
  556.           WriteLn;                              {         "                  }
  557.           Halt(1);                              {        end program         }
  558.         end;                                    {      ..                    }
  559.         If RC <> 0 then begin                   {      if bad return code    }
  560.           WriteLn;                              {        tell the user       }
  561.           WriteLn(' Return Code error: ', RC,  {         "                  }
  562.                   ' compressing ', SRec^.Name); {         "                  }
  563.           WriteLn;                              {         "                  }
  564.           Halt(1);                              {        end program         }
  565.         end;                                    {      ..                    }
  566.         Inc(FileCount);                         {      bump file count       }
  567.       end;                                      {    ..                      }
  568.     end                                         {  ..                        }
  569.     else begin                                  {  else                      }
  570.       Done:=True;                               {    flag we are done        }
  571.     end;                                        {  ..                        }
  572.     FindNext(SRec^);                            {  get next file to compress }
  573.   end; {while not done}                         {..                          }
  574.  
  575. { display files compressed count and total time }
  576.  
  577.   If FileCount = 0 then begin
  578.     WriteLn('No files found to Compress');
  579.   end
  580.   else begin
  581.     WriteLn;
  582.     Write(FileCount, ' File(s) added to: ', OutFile^);
  583.     WriteLn( ' in ', ((TimeStamp-BeginTime)/1000)+1:4:0, ' seconds');
  584.     WriteLn;
  585.   end;
  586.  
  587. { release heap memory used }
  588.  
  589.   Dispose(InFile);
  590.   Dispose(OutFile);
  591.   Dispose(TDir);
  592.   Dispose(Dir);
  593.   Dispose(Srec);
  594.  
  595. end; {ProcessCompress}
  596.  
  597.  
  598. {----------------------------------------------------------------------------}
  599. {                                                                            }
  600. {                    function    'ProcessDeCompress'                         }
  601. {                                                                            }
  602. {  This procedure controls the requested (D)ecompress option                 }
  603. {                                                                            }
  604. {----------------------------------------------------------------------------}
  605.  
  606. Function ProcessDeCompress(Option : Char) : Word;
  607.  
  608. Var
  609.   FileHdr     : FileHeaderPtr;        {my compress file header from heap     }
  610.   ActualR     : Word;                 {actual blockread bytes read           }
  611.   ActualW     : Word;                 {actual blockwrite bytes written       }
  612.   r           : Word;                 {return code                           }
  613.   Done        : Boolean;              {processing done flag                  }
  614.   Doit        : Boolean;              {decompress flag (to control overwrite)}
  615.   SkipFile    : Boolean;              {skip current file                     }
  616.   CurLoc      : LongInt;              {current file location in bytes        }
  617.   ToRead      : LongInt;              {file bytes to read (copy vs lzw)      }
  618.   LeftToReaD  : LongInt;              {file bytes left to read               }
  619.   Dir         : DirPtr;               {dir path from heap                    }
  620.   HoldDir     : DirPtr;               {dir path from heap to hold current dir}
  621.   Name        : NameStr;              {file name                             }
  622.   Ext         : ExtStr;               {file extension                        }
  623.   OutFile     : OutFilePtr;           {output file name from heap            }
  624.   InFile      : InFilePtr;            {input file name from heap             }
  625.   CopyPtr     : Pointer;              {pointer to heap buffer for block(r/w) }
  626.   IHandle     : Word;                 {handle of input file for mdcd1213.obj }
  627.   OHandle     : Word;                 {handle of output file for mdcd1213.obj}
  628.   HashPtr     : Pointer;              {pointer to heap allocated hash table  }
  629.   HashSeg     : Word;                 {segment of allocated hash table       }
  630.  
  631.  
  632. begin {ProcessDeCompress}
  633.  
  634. { allocate variables from the heap and initialize any required variables }
  635.  
  636.   New(Dir);                                    {allocate dir from heap       }
  637.   New(OutFile);                                {allocate output file fm heap }
  638.   New(InFile);                                 {allocate input file fm heap  }
  639.   BeginTime := TimeStamp;                      {get beginning time           }
  640.   FileCount := 0;                              {reset processed file count   }
  641.  
  642.  
  643. { split input compressed file name apart, and add an extension of .MD if  }
  644. { no file extension was entered.                                          }
  645.  
  646.   InFile^ := FExpand(ParamStr(2));             {                             }
  647.   FSplit(InFile^, Dir^, Name, Ext);            {                             }
  648.   If (Length(Ext)=0) then Ext:='.MD';          {                             }
  649.   InFile^ := Dir^ + Name + Ext;                {                             }
  650.  
  651.  
  652. { get the current directory, save it, fixup the output path, and attempt to }
  653. { do a chdir to it to verify that it is correct.                            }
  654.  
  655.   New(HoldDir);                                {allocate dir on heap         }
  656.   GetDir(0, HoldDir^);                         {get current directory        }
  657.   OutFile^ := ParamStr(3);                     {get outdir from command line }
  658.   ChDir(OutFile^);                             {attempt to chdir to out dir  }
  659.   if ((Length(OutFile^) > 0) and               {if any outdir entered and    }
  660.      (OutFile^[Length(OutFile^)] <> ':') and   { last char not ':' and       }
  661.      (OutFile^[Length(OutFile^)] <> '\')) then { last char not '\' then      }
  662.     OutFile^ := OutFile^ + '\';                {   slap a '\' on end         }
  663.   If (IOResult <> 0) then begin                {if chdir didnt work          }
  664.     ChDir(HoldDir^);                           {  back to original dir       }
  665.     WriteLn;                                   {  inform user                }
  666.  
  667.     WriteLn(' Parameter 3 (Output Directory) must be blank or be a valid Path');
  668.  
  669.     WriteLn;                                   {                             }
  670.     ProcessDeCompress := 1;                    {  set function return        }
  671.     Dispose(HoldDir);                          {  deallocate heap            }
  672.     Dispose(InFile);                           {  deallocate heap            }
  673.     Dispose(OutFile);                          {  deallocate heap            }
  674.     Dispose(Dir);                              {  deallocate heap            }
  675.     Exit;                                      {  exit                       }
  676.   end;                                         {..                           }
  677.   ChDir(HoldDir^);                             {change back to original dir  }
  678.  
  679. { attempt to open input compressed file and make sure its a valid file }
  680.  
  681.   Assign(InF, InFile^);
  682.   Reset(InF, 1);
  683.   If (IOResult <> 0) then begin
  684.     WriteLn;
  685.     WriteLn(' Requested file: ', InFile^, ' not found');
  686.     WriteLn;
  687.     ProcessDeCompress := 1;
  688.     Dispose(InFile);
  689.     Dispose(OutFile);
  690.     Dispose(Dir);
  691.     Exit;
  692.   end
  693.   else begin
  694.     BlockRead(InF, MDCheck, 4);
  695.     CheckIO(InF);
  696.     if (MDCheck <> ValidSig) then begin
  697.       WriteLn;
  698.       WriteLn('File: ', InFile^, ' is not a valid compress file');
  699.       WriteLn;
  700.       ProcessDeCompress := 1;
  701.       Dispose(InFile);
  702.       Dispose(OutFile);
  703.       Dispose(Dir);
  704.       Exit;
  705.     end;
  706.   end;
  707.  
  708. { initialize stuff and prepare to begin decompressing }
  709.  
  710.   New(FileHdr);                                 {allocate on heap            }
  711.   CurLoc := 0;                                  {input file position to read }
  712.   Seek(InF, CurLoc);                            {seek to current location    }
  713.   CheckIO(InF);
  714.   WriteLn;
  715.   Write('DeCompressing: ', InFile^);
  716.   If (Option = 'R') then
  717.     Write('  Duplicate Output files will be overwritten');
  718.   WriteLn;
  719.   WriteLn;
  720.  
  721. { go through the entire input compressed file and decompress it }
  722.  
  723.   Done := False;                               {reset done flag              }
  724.   While (Done = False) do begin                {while more to do             }
  725.     BlockRead(InF, FileHdr^,                   {  read compress header       }
  726.               SizeOf(FileHdr^), ActualR);      {                             }
  727.     CheckIO(InF);
  728.     CurLoc := CurLoc + SizeOf(FileHdr^);       {  point to compress data     }
  729.     If (ActualR = SizeOf(FileHdr^)) then begin {  if we read data ok..       }
  730.       With FileHdr^ do begin                   {    begin processing         }
  731.         SkipFile := False;                     {    assume file is ok        }
  732.         If (Signature <> ValidSig) then begin  {      if not valid signature }
  733.           WriteLn;                             {        tell user            }
  734.  
  735.           WriteLn('Compress file is corrupted.  Invalid signature found');
  736.  
  737.           WriteLn;                             {                             }
  738.           Halt(1);                             {        end program          }
  739.         end;                                   {      ..                     }
  740.  
  741.  
  742. { i only recognize header type 1 with this version }
  743.  
  744.         If (HeaderType <> 1) then begin        {      if invalid header type.}
  745.           WriteLn;                             {        tell user            }
  746.  
  747.           WriteLn('Unidentified Header Type.  File was compressed with a ',
  748.                 ' newer version. Skipping');
  749.  
  750.           SkipFile := True;                    {        skip this file       }
  751.           WriteLn;                             {                             }
  752.         end;                                   {      ..                     }
  753.  
  754. { if this file compressed with a newer release, ask user what to do }
  755.  
  756.         If ( (not SkipFile) and                {      if file still ok... &  }
  757.            (ReleaseLevel>PgmRelLvl) )then begin{      newer release level    }
  758.           Repeat                               {        flush keyboard buffer}
  759.             GetKey;                            {                             }
  760.           Until (InKey = 0);                   {                             }
  761.           Write('File: ', FileName,           {        ok to decompress?    }
  762.                 ' Compressed with version: ',  {                             }
  763.                 ReleaseLevel,                  {                             }
  764.                 '. Decompress it? ');          {                             }
  765.           Repeat                               {        wait for keypress    }
  766.             GetKey;                            {                             }
  767.           Until (InKey <> 0);                  {                             }
  768.           If (InKey = $2E03) then halt(0);     {        if ^C then end       }
  769.           If ((InKey shr 8)<>$15) then begin   {        if not y/Y           }
  770.             Write('Ignored ');                 {          ignore message     }
  771.             SkipFile := True;                  {          dont decompress it }
  772.           end;                                 {        ..                   }
  773.           WriteLn;                             {                             }
  774.         end;                                   {      ..                     }
  775.  
  776. { check type of compression used. if unrecognized, skip file }
  777.  
  778.         If ( (not SkipFile) and                {      if file still ok... &  }
  779.            (CompressType <> 0) and             {      not type 0 and         }
  780.            (CompressType <> 1) ) then begin    {      not type 1             }
  781.           Write('File: ', FileName,           {        ok to decompress?    }
  782.                 ' Compressed with Type: ',     {                             }
  783.                 CompressType,                  {                             }
  784.                 '. Unrecognized. Skipping ');  {                             }
  785.             SkipFile := True;                  {          dont decompress it }
  786.           WriteLn;                             {                             }
  787.         end;                                   {      ..                     }
  788.  
  789.         DoIt := True;                          {      assume decompression   }
  790.  
  791. { check if output file exists and if so, check with user }
  792.  
  793.   { NOTE: if Append, or some other such TSR is loaded and the file to be     }
  794.   {       decompressed is somewhere in the TSR's search path then you will   }
  795.   {       get the following message that says the file exists, even if it    }
  796.   {       doesn't.  Answering 'Y'es to the overwrite prompts will decompress }
  797.   {       the file correctly to the desired sub-directory.                   }
  798.  
  799.         If (SkipFile) then begin               {if file is to be skipped     }
  800.           DoIt := False;                       {  make it known to program   }
  801.         end                                    {..                           }
  802.         else begin                             {else                         }
  803.           Assign(OutF, OutFile^+FileName);     {  set up compress output file}
  804.           Reset(OutF, 1);                      {  try and open output file   }
  805.           If (IOResult = 0) then begin         {  if file already exists     }
  806.             Close(OutF);                       {    close the file           }
  807.             CheckIO(OutF);
  808.             If (Option <> 'R') then begin      {    if replace not selectd   }
  809.               Repeat                           {      flush keyboard buffer  }
  810.                 GetKey;                        {                             }
  811.               Until (InKey = 0);               {                             }
  812.               Write('Output file: ',          {      ask if overwrite ok    }
  813.                     OutFile^+FileName,         {                             }
  814.                     ' Exists.  Overwrite? ');  {                             }
  815.               Repeat                           {      wait for keypress      }
  816.                 GetKey;                        {                             }
  817.               Until (InKey <> 0);              {                             }
  818.               If (InKey = $2E03) then halt(0); {      if ^C then end program }
  819.               If ((InKey shr 8)<>$15)          {      if not  y/Y            }
  820.                   then begin                   {                             }
  821.                 Write('Bypassed');             {        write bypassed msg   }
  822.                 DoIt := False;                 {        dont decompress it   }
  823.               end;                             {      ..                     }
  824.               WriteLn;                         {                             }
  825.             end                                {    ..                       }
  826.             else begin                         {    else                     }
  827.               Write('OverWriting & ');         {      say we're overwriting  }
  828.             end;                               {    ..                       }
  829.           end;  {if ioresult = 0}              {  ..                         }
  830.         end; {if skipfile}                     {..                           }
  831.  
  832.  
  833. { everything is cool - decompress the file }
  834.  
  835.         If (DoIt) then begin                   {  if ok to decompress        }
  836.           ReWrite(OutF, 1);                    {    open empty output file   }
  837.           CheckIO(OutF);
  838.           IHandle := FileRec(InF).Handle;      {    get input DOS handle     }
  839.           OHandle := FileRec(OutF).Handle;     {    get output DOS handle    }
  840.           StartTime := TimeStamp;              {    get start time           }
  841.           Case CompressType of                 {                             }
  842.             Compressed : begin                 {    if LZW compressed file   }
  843.               Write('UnLZW13ing: ',            {      tell user what we doing}
  844.                      FileName:12, ' --> ',     {                             }
  845.                      OutFile^, '  ');          {                             }
  846.               GetMem(HashPtr, LZWH2+15);       {      get heap for hash decmp}
  847.               if Ofs(HashPtr^) = 0 then        {      align on segment bndry }
  848.                 HashSeg := Seg(HashPtr^)       {                             }
  849.               else                             {                             }
  850.                 HashSeg := 1+Seg(HashPtr^);    {                             }
  851.               r := DeCompressFile(Ihandle,     {      input file handle      }
  852.                                   Ohandle,     {      output file handle     }
  853.                                   CurLoc,      {      byte where file starts }
  854.                                   @ReturnR,    {      address of return code }
  855.                                   HashSeg,     {      segment of hash table  }
  856.                                   LZWBits);    {      number of LZW bits     }
  857.               FreeMem(HashPtr, LZWH2+15);      {      release heap hash table}
  858.  
  859.             { display error and halt if error return code }
  860.  
  861.               If (r <> $ffff) then begin
  862.                 WriteLn;
  863.                 WriteLn('Error: ', r, ' returned from MDCD1213.OBJ - Program Terminated');
  864.                 WriteLn;
  865.                 Halt(1);
  866.               end;
  867.  
  868.               If (ReturnR.FileCrc <> FileCrc)  {      if decompress crc error}
  869.                 then begin                     {        tell user            }
  870.  
  871.                 WriteLn('CRC ERROR - File left in place but is corrupted');
  872.  
  873.                 FileDate := 0;                 {        file date/time = zero}
  874.               end;                             {      ..                     }
  875.               SetFTime(OutF, FileDate);        {      set file date          }
  876.               CheckIO(OutF);
  877.               Close(OutF);                     {      close output file      }
  878.               CheckIO(OutF);
  879.               SetFAttr(OutF, FileAttr);        {      set original file attr }
  880.               CheckIO(OutF);
  881.               Inc(FileCount);                  {      bump file count        }
  882.             end; {case compressed}             {    ..                       }
  883.                                                {                             }
  884.             UnCompressed : begin               {    If file not compressed.. }
  885.               Write('UnStoring : ',FileName:12,{      tell user what we doing}
  886.                     ' --> ', OutFile^, '  ');  {                             }
  887.               Seek(InF, CurLoc);               {      position to file begin }
  888.               CheckIO(OutF);
  889.               GetMem(CopyPtr, LZWH1);          {      get copy buffer        }
  890.               LeftToRead := OrigFileSize;      {      bytes left = original  }
  891.               While (LeftToRead > 0) do begin  {      while anything left    }
  892.                 If LeftToRead >= LZWH1 then    {        if more than buffer  }
  893.                   ToRead := LZWH1              {          read whole buffer  }
  894.                 else                           {        else                 }
  895.                   ToRead := LeftToRead;        {          read remainder     }
  896.                 LeftToRead:=LeftToRead-ToRead; {        adjust remaining     }
  897.                 BlockRead(InF, CopyPtr^,       {        read input           }
  898.                           ToRead, ActualR);    {                             }
  899.                 CheckIO(OutF);
  900.                 BlockWrite(OutF, CopyPtr^,     {        write output         }
  901.                           ActualR, ActualW);   {                             }
  902.                 CheckIO(OutF);
  903.                 if ActualW<>ActualR then begin {        if write <> read     }
  904.                   WriteLn;                     {          disk probaly full  }
  905.                   WriteLn('DISK FULL???');   {          disk probaly full  }
  906.                   WriteLn('DISK FULL???');   {                             }
  907.                   WriteLn;                     {          disk probaly full  }
  908.                   Halt(99);                    {          end program        }
  909.                 end;                           {        ..                   }
  910.               end;                             {      ..                     }
  911.               FreeMem(CopyPtr, LZWH1);         {      release buffer         }
  912.               SetFTime(OutF, FileDate);        {      set file date/time     }
  913.               CheckIO(OutF);
  914.               Close(OutF);                     {      close output file      }
  915.               CheckIO(OutF);
  916.               SetFAttr(OutF, FileAttr);        {      set original attr      }
  917.               CheckIO(OutF);
  918.               Inc(FileCount);                  {      bump file count        }
  919.             end; {case uncompressed}           {    ..                       }
  920.                                                {                             }
  921.           end; {case}
  922.           Write( ' ', ((TimeStamp-StartTime)/1000)+1:4:0, ' seconds');
  923.           WriteLn;
  924.         end; {if DoIt}                         {  ..                         }
  925.         CurLoc:=CurLoc + CompFileSize;         {  point to next file         }
  926.         Seek(InF, CurLoc);                     {  seek to next header        }
  927.         CheckIO(InF);
  928.  
  929.       end; {with FileHdr^}                     {..                           }
  930.  
  931.     end {if ActualR = sizeof(filehdr^}
  932.  
  933.     else begin
  934.       Done := True;
  935.     end;
  936.  
  937.   end; {while done = false }
  938.  
  939.   Close(InF);                                  {close input file             }
  940.   CheckIO(OutF);
  941.  
  942. { display number of files decompressed and time to decompress }
  943.  
  944.   If FileCount = 0 then begin
  945.     WriteLn('No files were DeCompressed');
  946.   end
  947.   else begin
  948.     WriteLn;
  949.     Write(FileCount, ' File(s) DeCompressed from: ', InFile^);
  950.     WriteLn( ' in ', ((TimeStamp-BeginTime)/1000)+1:4:0, ' seconds');
  951.     WriteLn;
  952.   end;
  953.  
  954. { release all allocated heap space }
  955.  
  956.   Dispose(HoldDir);
  957.   Dispose(FileHdr);
  958.   Dispose(InFile);
  959.   Dispose(OutFile);
  960.   Dispose(Dir);
  961.  
  962. end; {ProcessDeCompress}
  963.  
  964.  
  965. {----------------------------------------------------------------------------}
  966. {                                                                            }
  967. {                    function    'ProcessList'                               }
  968. {                                                                            }
  969. {  This procedure (L)ists all the files in the compressed file               }
  970. {                                                                            }
  971. {----------------------------------------------------------------------------}
  972.  
  973. Function ProcessList(Option : Char) : Word;
  974.  
  975. Type
  976.   DirPtr     = ^DirStr;                   {to allcocate dir path on heap     }
  977.   OutFilePtr = ^PathStr;                  {to allocate output file on heap   }
  978.  
  979. Const
  980.   OrigTotal : LongInt = 0;                {total size of files orginally     }
  981.   CompTotal : LongInt = 0;                {total size of files compressed    }
  982.   OvhdTotal : LongInt = 0;                {total size of file overhead (hdrs)}
  983.   PctTotal  : LongInt = 0;                {total file compression percentage }
  984.   Spaces    : String[6] = '';             {to print variable spaces          }
  985.  
  986. Var
  987.   FileHdr  : FileHeaderPtr;               {compress file header on heap      }
  988.   ActualR  : Word;                        {actual bytes read                 }
  989.   Lines    : Word;                        {screen display line count for paws}
  990.   i        : Word;                        {loop variable                     }
  991.   Done     : Boolean;                     {done processing flag              }
  992.   CurLoc   : LongInt;                     {current location in file          }
  993.   Dir      : DirPtr;                      {heap space for dir path           }
  994.   Name     : NameStr;                     {file name                         }
  995.   Ext      : ExtStr;                      {file extension                    }
  996.   OutFile  : OutFilePtr;                  {heap space for output file name   }
  997.   DT       : DateTime;                    {unpack space for file date/time   }
  998.  
  999. { local function to convert word to 2 byte string and pad with zero }
  1000.  
  1001.   Function CVS(W : Word) : String2;
  1002.     Var S : String[2];
  1003.     begin
  1004.       Str(W:2, S);                        {convert word to string            }
  1005.       If S[1]=' ' then S[1]:='0';         {if 1st position blank, make '0'   }
  1006.       CVS:=S;                             {return string to caller           }
  1007.     end;
  1008.  
  1009.  
  1010. begin {ProcessList}
  1011.  
  1012. { allocate heap variables }
  1013.  
  1014.   New(Dir);
  1015.   New(OutFile);
  1016.  
  1017. { split input compress file on command line into components, append a file }
  1018. { extension of .MD if not specified, rebuild file name and make upper case }
  1019.  
  1020.   FSplit(ParamStr(2), Dir^, Name, Ext);
  1021.   if (Length(Ext)=0) then Ext:='.MD';
  1022.   OutFile^ := Dir^ + Name + Ext;
  1023.   For i:=1 to Length(OutFile^) do
  1024.     OutFile^[i] := UpCase(OutFile^[i]);
  1025.  
  1026. { attempt to open compress file, and make sure it has a valid signature }
  1027.  
  1028.   Assign(InF, OutFile^);
  1029.   Reset(InF, 1);
  1030.   If (IOResult <> 0) then begin
  1031.     WriteLn;
  1032.     WriteLn(' Requested file: ', OutFile^, ' not found');
  1033.     WriteLn;
  1034.     ProcessList := 1;
  1035.     Dispose(OutFile);
  1036.     Dispose(Dir);
  1037.     Exit;
  1038.   end
  1039.   else begin
  1040.     BlockRead(InF, MDCheck, 4);
  1041.     if (MDCheck <> ValidSig) then begin
  1042.       WriteLn;
  1043.       WriteLn('File: ', OutFile^, ' is not a valid compress file');
  1044.       WriteLn;
  1045.       ProcessList := 1;
  1046.       Dispose(OutFile);
  1047.       Dispose(Dir);
  1048.       Exit;
  1049.     end;
  1050.   end;
  1051.  
  1052. { initialize variables, allocate needed heap space, and display heading }
  1053.  
  1054.   Done := False;
  1055.   New(FileHdr);
  1056.   CurLoc := 0;
  1057.   Seek(InF, CurLoc);
  1058.   CheckIO(InF);
  1059.   WriteLn;
  1060.   WriteLn('Compressed File: ', OutFile^);
  1061.   WriteLn;
  1062.   WriteLn('               ORIG    CMP    HDR  CMP  CMP  PRG       ');
  1063.   Write  ('   FILE NAME   SIZE    SIZE   LEN  PCT  TYP  VER  CRC  ');
  1064.   if (Option = 'L') then
  1065.     WriteLn('  DATE      TIME')
  1066.   else
  1067.     WriteLn('ORIGINAL PATH');
  1068.   WriteLn(Dashes);
  1069.   Lines := 0;
  1070.  
  1071. { go through and display one line for each file in the compress file }
  1072.  
  1073.   While (Done = False) do begin
  1074.     BlockRead(InF, FileHdr^, SizeOf(FileHdr^), ActualR);
  1075.     CheckIO(InF);
  1076.     If (ActualR = SizeOf(FileHdr^)) then begin
  1077.       With FileHdr^ do begin
  1078.         if (Signature<> ValidSig) then begin
  1079.           WriteLn;
  1080.           WriteLn('Compress file is corrupted.  Invalid signature found');
  1081.           WriteLn;
  1082.           Halt(1);
  1083.         end;
  1084.         OrigTotal := OrigTotal + OrigFileSize;
  1085.         CompTotal := CompTotal + CompFileSize;
  1086.         OvhdTotal := OvhdTotal + HeaderSize;
  1087.         FSplit(FileName, Dir^, Name, Ext);
  1088.         Write(Name:8, Ext);
  1089.         Write(Spaces:5-Length(Ext));
  1090.         Write(OrigFileSize:7, ' ');
  1091.         Write(CompFileSize:7, ' ');
  1092.         Write(HeaderSize:5, ' ');
  1093.         If (OrigFileSize = CompFileSize) then
  1094.           Write(' 0% ')
  1095.         else
  1096.           Write(99-((CompFileSize * 100) / OrigFileSize):2:0, '% ');
  1097.         Case CompressType of
  1098.           Compressed   : Write('LZW13 ');
  1099.           UnCompressed : Write('NONE  ');
  1100.         end;
  1101.         Write(ReleaseLevel:2, '  ');
  1102.         Write(HexXlate[Hi(FileCrc) shr 4]);
  1103.         Write(HexXlate[Hi(FileCrc) and $F]);
  1104.         Write(HexXlate[Lo(FileCrc) shr 4]);
  1105.         Write(HexXlate[Lo(FileCrc) and $F]);
  1106.  
  1107.    { display file date & time if 'L' option or original path if 'F' }
  1108.  
  1109.         if (Option='L') then begin
  1110.           UnpackTime(FileDate, DT);
  1111.           WorkStr:=CVS(DT.Month)+'-'+CVS(DT.Day)+'-'+CVS(DT.Year-1900);
  1112.           Write('  ', WorkStr);
  1113.           WorkStr:=CVS(DT.Hour)+':'+CVS(DT.Min)+':'+CVS(DT.Sec);
  1114.           Write('  ', WorkStr);
  1115.         end
  1116.         else begin
  1117.           Write('  ', PathName);
  1118.         end;
  1119.         WriteLn;
  1120.         Inc(Lines);
  1121.  
  1122.     { if display is full, pause for any key.. }
  1123.  
  1124.         If (Lines = 18) then begin
  1125.           Lines := 0;
  1126.           Write('Pausing...');
  1127.           Repeat
  1128.             GetKey;
  1129.           Until (InKey <> 0);
  1130.           Write(#8#8#8#8#8#8#8#8#8#8#8);
  1131.         end;
  1132.         CurLoc:=CurLoc+HeaderSize+CompFileSize;
  1133.         Seek(InF, CurLoc);
  1134.         CheckIO(InF);
  1135.       end;
  1136.     end
  1137.     else begin
  1138.       Done := True;
  1139.     end;
  1140.   end;
  1141.  
  1142. { display compress file totals }
  1143.  
  1144.   If (OrigTotal = 0) then
  1145.     PctTotal := 0
  1146.   else
  1147.     PctTotal := 99 - ((CompTotal * 100 ) div OrigTotal);
  1148.  
  1149.     if (PctTotal = -1) then
  1150.       PctTotal := 0;
  1151.   WriteLn('              ------  ------  ---- -- ');
  1152.   WriteLn('            ', OrigTotal:8, CompTotal:8, OvhdTotal:6, PctTotal:3, '%');
  1153.  
  1154. { release allocated heap space, clean up and return }
  1155.  
  1156.   CLose(InF);
  1157.   CheckIO(InF);
  1158.   Dispose(FileHdr);
  1159.   Dispose(OutFile);
  1160.   Dispose(Dir);
  1161.  
  1162. end; {ProcessList}
  1163.  
  1164.  
  1165. {----------------------------------------------------------------------------}
  1166. {                                                                            }
  1167. {                    procedure   'DisplayHelp'                               }
  1168. {                                                                            }
  1169. {  This procedure displays help information for running this program         }
  1170. {                                                                            }
  1171. {----------------------------------------------------------------------------}
  1172.  
  1173. Procedure DisplayHelp;
  1174.  
  1175. begin {DisplayHelp}
  1176.  
  1177.   WriteLn('Usage:');
  1178.   WriteLn('  MDCD [c]  [d:][path]AnyFile{wildcards ok}  [d:][path]CompressFile[.ext(.md)]');
  1179.   WriteLn('  MDCD [dr] [d:][path]CompressFile[.ext(.md)]  [d:][path]');
  1180.   WriteLn('  MDCD [lf] [d:][path]CcompressFile[.ext(.md)]');
  1181.   WriteLn;
  1182.   WriteLn('Options: C = Compress file(s)');
  1183.   WriteLn('         D = Decompress file(s) with pause if output file exists');
  1184.   WriteLn('         R = Decompress file(s) with automatic file overwrite');
  1185.   WriteLn('         L = list file(s) in compress file - show date & time');
  1186.   WriteLn('         F = list file(s) in compress file - show original file path');
  1187.   WriteLn;
  1188.   WriteLn('Examples:');
  1189.   WriteLn(' mdcd c q.exe quattro.cd ;compress q.exe & add to quattro.cd');
  1190.   WriteLn(' mdcd c *.pas mypas.cd   ;compress all .pas files & add to mypas.cd');
  1191.   WriteLn(' mdcd c *.wkq quat       ;compress all .wkq files & add to quat.md ');
  1192.   WriteLn(' mdcd l mypas.cd         ;list file(s) in mypas.cd with date and time');
  1193.   WriteLn(' mdcd f quattro          ;list file(s) in quattro.md w/original drive/path name');
  1194.   WriteLn(' mdcd d mypas.cd         ;decompress mypas.cd into current directory');
  1195.   WriteLn(' mdcd d quat e:\quattro  ;decompress quat.md into e:\quattro directory');
  1196.   WriteLn(' mdcd r quat             ;decompress quat.md to current dir with file overwrite');
  1197.  
  1198. end; {DisplayHelp}
  1199.  
  1200.  
  1201. {----------------------------------------------------------------------------}
  1202. {                                                                            }
  1203. {                              'MAINLINE PROGRAM'                            }
  1204. {                                                                            }
  1205. {----------------------------------------------------------------------------}
  1206.  
  1207. Begin
  1208.  
  1209. { write program logo screen }
  1210.  
  1211.   DosError := 0;
  1212.   WriteLn;
  1213.   WriteLn(Hdr1);
  1214.   WriteLn(Hdr2);
  1215.   WriteLn;
  1216.  
  1217. { check command line parameter for valid option.  display help if not valid }
  1218.  
  1219.   WorkStr := ParamStr(1);
  1220.   Option := UpCase(WorkStr[1]);
  1221.   If ( (Length(WorkStr) <> 1) ) or
  1222.      ( (Option<>'C') and
  1223.        (Option<>'D') and
  1224.        (Option<>'R') and
  1225.        (Option<>'L') and
  1226.        (Option<>'F') ) then begin
  1227.     DisplayHelp;
  1228.     Halt(1);
  1229.   end;
  1230.  
  1231. { valid option. call the appropriate routine to process }
  1232.  
  1233.   Case Option of
  1234.     'C' : begin                                         {compress            }
  1235.             If (Length(ParamStr(2))=0) then begin
  1236.               WriteLn('Parm 2 must be an input file name/wildcard mask');
  1237.               Halt(1)
  1238.             end;
  1239.             If (Length(ParamStr(3))=0) then begin
  1240.               WriteLn('Parm 3 must be the name of the compressed output file');
  1241.               Halt(1);
  1242.             end;
  1243.             MRC:=ProcessCompress;
  1244.           end;
  1245.  'R','D': begin                                         {decompress/overwrite}
  1246.             If (Length(ParamStr(2))=0) then begin
  1247.               WriteLn('Parm 2 must be a valid compressed file');
  1248.               Halt(1)
  1249.             end;
  1250.             MRC:=ProcessDeCompress(Option);
  1251.           end;
  1252.  'L','F': begin                                         {list date or path   }
  1253.             If (Length(ParamStr(2))=0) then begin
  1254.               WriteLn('Parameter 2 must be a valid compressed file');
  1255.               Halt(1);
  1256.             end;
  1257.             MRC:=ProcessList(Option);
  1258.           end;
  1259.   end;
  1260.  
  1261. End.
  1262.  
  1263.